home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / src / changede.c < prev    next >
Text File  |  1994-01-03  |  43KB  |  1,832 lines
  1. # include "ChangeDe.h"
  2. # include "yyCDefs.w"
  3. # include <stdio.h>
  4. # if defined __STDC__ | defined __cplusplus
  5. #  include <stdlib.h>
  6. # else
  7.    extern void exit ();
  8. # endif
  9. # include "Tree.h"
  10. # include "Definiti.h"
  11.  
  12. # ifndef NULL
  13. # define NULL 0L
  14. # endif
  15. # ifndef false
  16. # define false 0
  17. # endif
  18. # ifndef true
  19. # define true 1
  20. # endif
  21.  
  22. # ifdef yyInline
  23. # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) \
  24.   if ((ptr = (tree) free) >= (tree) max) ptr = alloc (); \
  25.   free += nodesize [kind]; \
  26.   ptr->yyHead.yyMark = 0; \
  27.   ptr->Kind = kind;
  28. # else
  29. # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) ptr = make (kind);
  30. # endif
  31.  
  32. # define yyWrite(s) (void) fputs (s, yyf)
  33. # define yyWriteNl (void) fputc ('\n', yyf)
  34.  
  35. # line 43 "ChangeDefs.puma"
  36.  
  37.  
  38. # include "Idents.h"
  39. # include "StringMe.h"
  40. # include "Types.h"
  41.  
  42. # include "protocol.h"
  43.  
  44. # include "Transfor.h"  /* AppendDECLS */
  45.  
  46. tTree stmtfuncs;  /* list of statement functions */
  47.  
  48.  
  49.  
  50. static FILE * yyf = stdout;
  51.  
  52. static void yyAbort
  53. # ifdef __cplusplus
  54.  (char * yyFunction)
  55. # else
  56.  (yyFunction) char * yyFunction;
  57. # endif
  58. {
  59.  (void) fprintf (stderr, "Error: module ChangeDefs, routine %s failed\n", yyFunction);
  60.  exit (1);
  61. }
  62.  
  63. void MakeObjType ARGS((tTree decl, tDefinitions obj));
  64. static bool SetDeclType ARGS((tTree decl, tTree type));
  65. void MakeObjParameter ARGS((tTree decl, tDefinitions obj));
  66. void MakeObjDimension ARGS((tTree indexes, tDefinitions obj));
  67. static void SetDeclDimension ARGS((tTree decl, tTree indexes));
  68. void MakeObjIntent ARGS((tDefinitions obj, int intent));
  69. void MakeObjOptional ARGS((tDefinitions obj));
  70. void MakeObjCommon ARGS((tTree decl, tDefinitions obj));
  71. static tTree TreeTypeCombine ARGS((tTree d1, tTree d2));
  72. void MakeObjSequential ARGS((tTree t, tDefinitions v));
  73. void MakeObjNoSequential ARGS((tTree t, tDefinitions v));
  74. void MakeObjSave ARGS((tTree t, tDefinitions v));
  75. void MakeObjDistribution ARGS((tTree layout, tDefinitions obj));
  76. static void CheckDistributionSpecification ARGS((tTree layout, int rank));
  77. static tDefinitions GetDistribution ARGS((tTree t));
  78. static bool IsSerialDistribution ARGS((tTree t));
  79. static DistributedDimensions GetDistributedDimensions ARGS((tTree t, int n));
  80. void MakeObjAlignment ARGS((tTree align, tDefinitions obj));
  81. static tDefinitions GetAlignDistribution ARGS((tTree align, int rank));
  82. static tDefinitions MakeAlignDistribution ARGS((tTree template, tTree source));
  83. static void GenFullAlignSource ARGS((tTree align, int rank));
  84. static void GenFullAlignSpec ARGS((tTree align));
  85. static bool CorrectAlignSpec ARGS((tTree align));
  86. static int FillAlignSpec ARGS((tTree t, int n));
  87. static DistributedDimensions FindAllSourceDimensions ARGS((tTree spec, tTree source, int n));
  88. static int FindSourceDimension ARGS((tTree spec, tTree source, int n));
  89. static tDefinitions GetExtFuncEntry ARGS((tIdent name, tTree type));
  90. void MakeObjExternal ARGS((tTree decl, tDefinitions oldobj));
  91. void StatementFunctions ARGS((tTree body));
  92. static tTree ExtractStatementFunctions ARGS((tTree t));
  93. static bool IsStatementFunction ARGS((tTree t));
  94. static tTree MakeStmtFuncDecl ARGS((tTree var, tTree exp));
  95. static tTree MakeStmtFuncFormals ARGS((tTree Parameters));
  96.  
  97. void MakeObjType
  98. # if defined __STDC__ | defined __cplusplus
  99. (register tTree decl, register tDefinitions obj)
  100. # else
  101. (decl, obj)
  102.  register tTree decl;
  103.  register tDefinitions obj;
  104. # endif
  105. {
  106.   if (decl == NoTree) return;
  107.   if (obj == NoDefinitions) return;
  108.   if (decl->Kind == kVAR_DECL) {
  109.   if (decl->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
  110. # line 71 "ChangeDefs.puma"
  111.   {
  112. # line 72 "ChangeDefs.puma"
  113.    MakeObjDimension (decl->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES, obj);
  114. # line 73 "ChangeDefs.puma"
  115.    MakeObjType (decl->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_COMP_TYPE, obj);
  116.   }
  117.    return;
  118.  
  119.   }
  120. # line 76 "ChangeDefs.puma"
  121.   {
  122. # line 77 "ChangeDefs.puma"
  123.    MakeObjType (decl->VAR_DECL.VAL, obj);
  124.   }
  125.    return;
  126.  
  127.   }
  128.   if (decl->Kind == kARRAY_TYPE) {
  129. # line 80 "ChangeDefs.puma"
  130.   {
  131. # line 81 "ChangeDefs.puma"
  132.    MakeObjDimension (decl->ARRAY_TYPE.ARRAY_INDEX_TYPES, obj);
  133. # line 82 "ChangeDefs.puma"
  134.    MakeObjType (decl->ARRAY_TYPE.ARRAY_COMP_TYPE, obj);
  135.   }
  136.    return;
  137.  
  138.   }
  139.   if (obj->Kind == kVarObject) {
  140.   if (obj->VarObject.Kind->Kind == kVarConstant) {
  141. # line 85 "ChangeDefs.puma"
  142.   {
  143. # line 86 "ChangeDefs.puma"
  144.  obj->VarObject.Kind->VarConstant.Type = decl;
  145.   }
  146.    return;
  147.  
  148.   }
  149. # line 89 "ChangeDefs.puma"
  150.  {
  151.   bool okay;
  152.   {
  153. # line 90 "ChangeDefs.puma"
  154.  
  155. # line 91 "ChangeDefs.puma"
  156.    okay = SetDeclType (obj->VarObject.decl, decl);
  157. # line 92 "ChangeDefs.puma"
  158.  if (!okay)
  159.         { obj_error_protocol ("var_object has already a type", obj);
  160.           tree_protocol ("new type was : ", decl);
  161.         }
  162.  
  163.   }
  164.    return;
  165.  }
  166.  
  167.   }
  168.   if (obj->Kind == kFuncObject) {
  169.   if (obj->FuncObject.decl->Kind == kFUNC_DECL) {
  170. # line 100 "ChangeDefs.puma"
  171.  {
  172.   tTree newtype;
  173.   {
  174. # line 106 "ChangeDefs.puma"
  175.  
  176. # line 107 "ChangeDefs.puma"
  177.    newtype = TreeTypeCombine (obj->FuncObject.decl->FUNC_DECL.RESULT_TYPE, decl);
  178. # line 109 "ChangeDefs.puma"
  179.  if (newtype == NoTree)
  180.         { obj_error_protocol ("illegal retyping of function", obj);
  181.           tree_error_protocol ("new type should be", decl);
  182.         }
  183.        else
  184.         obj->FuncObject.decl->FUNC_DECL.RESULT_TYPE = newtype;
  185.  
  186.   }
  187.    return;
  188.  }
  189.  
  190.   }
  191.   if (obj->FuncObject.decl->Kind == kFUNC_PARAM_DECL) {
  192. # line 118 "ChangeDefs.puma"
  193.  {
  194.   tTree newtype;
  195.   {
  196. # line 122 "ChangeDefs.puma"
  197.  
  198. # line 123 "ChangeDefs.puma"
  199.    newtype = TreeTypeCombine (obj->FuncObject.decl->FUNC_PARAM_DECL.RESULT_TYPE, decl);
  200. # line 125 "ChangeDefs.puma"
  201.  if (newtype == NoTree)
  202.         { obj_error_protocol ("illegal retyping of function parameter", obj);
  203.           tree_protocol ("type specification is", decl);
  204.         }
  205.        else
  206.         obj->FuncObject.decl->FUNC_PARAM_DECL.RESULT_TYPE = newtype;
  207.  
  208.   }
  209.    return;
  210.  }
  211.  
  212.   }
  213.   }
  214. # line 134 "ChangeDefs.puma"
  215.   {
  216. # line 135 "ChangeDefs.puma"
  217.    obj_error_protocol ("this objection must not have a type", obj);
  218. # line 136 "ChangeDefs.puma"
  219.    tree_protocol ("type specification is", decl);
  220.   }
  221.    return;
  222.  
  223. ;
  224. }
  225.  
  226. static bool SetDeclType
  227. # if defined __STDC__ | defined __cplusplus
  228. (register tTree decl, register tTree type)
  229. # else
  230. (decl, type)
  231.  register tTree decl;
  232.  register tTree type;
  233. # endif
  234. {
  235. # line 141 "ChangeDefs.puma"
  236.  tTree newtype; bool ok;
  237.   if (decl->Kind == kVAR_DECL) {
  238. # line 143 "ChangeDefs.puma"
  239.   {
  240. # line 144 "ChangeDefs.puma"
  241.  newtype = TreeTypeCombine (decl->VAR_DECL.VAL, type);
  242.       ok = (newtype != NoTree);
  243.       if (ok) decl->VAR_DECL.VAL = newtype;
  244.  
  245.   }
  246.    return ok;
  247.  
  248.   }
  249.   if (decl->Kind == kVAR_PARAM_DECL) {
  250. # line 151 "ChangeDefs.puma"
  251.   {
  252. # line 152 "ChangeDefs.puma"
  253.  newtype = TreeTypeCombine (decl->VAR_PARAM_DECL.VAL, type);
  254.       ok = (newtype != NoTree);
  255.       if (ok) decl->VAR_PARAM_DECL.VAL = newtype;
  256.  
  257.   }
  258.    return ok;
  259.  
  260.   }
  261. # line 159 "ChangeDefs.puma"
  262.   {
  263. # line 160 "ChangeDefs.puma"
  264.    failure_protocol ("ChangeDefs", "SetDeclType", decl);
  265.   }
  266.    return false;
  267.  
  268. }
  269.  
  270. void MakeObjParameter
  271. # if defined __STDC__ | defined __cplusplus
  272. (register tTree decl, register tDefinitions obj)
  273. # else
  274. (decl, obj)
  275.  register tTree decl;
  276.  register tDefinitions obj;
  277. # endif
  278. {
  279.   if (decl == NoTree) return;
  280.   if (obj == NoDefinitions) return;
  281.   if (decl->Kind == kPARAMETER_DECL) {
  282.   if (obj->Kind == kVarObject) {
  283.   if (obj->VarObject.decl->Kind == kVAR_DECL) {
  284.   if (obj->VarObject.Kind->Kind == kVarLocal) {
  285. # line 172 "ChangeDefs.puma"
  286.   {
  287. # line 174 "ChangeDefs.puma"
  288.    obj->VarObject.Kind = mVarConstant (decl->PARAMETER_DECL.VAL, obj->VarObject.decl->VAR_DECL.VAL);
  289. # line 175 "ChangeDefs.puma"
  290.  obj->VarObject.decl = decl;
  291.   }
  292.    return;
  293.  
  294.   }
  295.   }
  296.   if (obj->VarObject.Kind->Kind == kVarDummy) {
  297. # line 178 "ChangeDefs.puma"
  298.   {
  299. # line 180 "ChangeDefs.puma"
  300.    obj_error_protocol ("PARAMETER not for dummy variable : ", obj);
  301. # line 181 "ChangeDefs.puma"
  302.    tree_protocol ("parameter attribute is : ", decl);
  303.   }
  304.    return;
  305.  
  306.   }
  307.   if (obj->VarObject.Kind->Kind == kVarCommon) {
  308. # line 184 "ChangeDefs.puma"
  309.   {
  310. # line 186 "ChangeDefs.puma"
  311.    obj_error_protocol ("PARAMETER not for common variable : ", obj);
  312. # line 187 "ChangeDefs.puma"
  313.    tree_protocol ("parameter attribute is : ", decl);
  314.   }
  315.    return;
  316.  
  317.   }
  318.   if (obj->VarObject.Kind->Kind == kVarConstant) {
  319. # line 190 "ChangeDefs.puma"
  320.   {
  321. # line 192 "ChangeDefs.puma"
  322.    obj_error_protocol ("PARAMETER is twice : ", obj);
  323. # line 193 "ChangeDefs.puma"
  324.    tree_protocol ("parameter attribute is : ", decl);
  325.   }
  326.    return;
  327.  
  328.   }
  329.   }
  330.   }
  331. # line 196 "ChangeDefs.puma"
  332.   {
  333. # line 197 "ChangeDefs.puma"
  334.    obj_error_protocol ("PARAMETER not allowed here", obj);
  335. # line 198 "ChangeDefs.puma"
  336.    tree_protocol ("parameter attribute is : ", decl);
  337.   }
  338.    return;
  339.  
  340. ;
  341. }
  342.  
  343. void MakeObjDimension
  344. # if defined __STDC__ | defined __cplusplus
  345. (register tTree indexes, register tDefinitions obj)
  346. # else
  347. (indexes, obj)
  348.  register tTree indexes;
  349.  register tDefinitions obj;
  350. # endif
  351. {
  352.   if (indexes == NoTree) return;
  353.   if (obj == NoDefinitions) return;
  354.   if (obj->Kind == kVarObject) {
  355.   if (obj->VarObject.decl->Kind == kVAR_DECL) {
  356.   if (obj->VarObject.decl->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
  357. # line 209 "ChangeDefs.puma"
  358.   {
  359. # line 210 "ChangeDefs.puma"
  360.    obj_error_protocol ("Object has already DIMENSION attribute", obj);
  361.   }
  362.    return;
  363.  
  364.   }
  365.   }
  366.   if (obj->VarObject.decl->Kind == kVAR_PARAM_DECL) {
  367.   if (obj->VarObject.decl->VAR_PARAM_DECL.VAL->Kind == kARRAY_TYPE) {
  368. # line 213 "ChangeDefs.puma"
  369.   {
  370. # line 214 "ChangeDefs.puma"
  371.    obj_error_protocol ("Object has already DIMENSION attribute", obj);
  372.   }
  373.    return;
  374.  
  375.   }
  376.   }
  377. # line 217 "ChangeDefs.puma"
  378.   {
  379. # line 218 "ChangeDefs.puma"
  380.    SetDeclDimension (obj->VarObject.decl, indexes);
  381.   }
  382.    return;
  383.  
  384.   }
  385. # line 222 "ChangeDefs.puma"
  386.   {
  387. # line 223 "ChangeDefs.puma"
  388.    obj_error_protocol ("this object must not have DIMENSION", obj);
  389. # line 224 "ChangeDefs.puma"
  390.    tree_protocol ("Dimension Indexes are : ", indexes);
  391.   }
  392.    return;
  393.  
  394. ;
  395. }
  396.  
  397. static void SetDeclDimension
  398. # if defined __STDC__ | defined __cplusplus
  399. (register tTree decl, register tTree indexes)
  400. # else
  401. (decl, indexes)
  402.  register tTree decl;
  403.  register tTree indexes;
  404. # endif
  405. {
  406.   if (decl == NoTree) return;
  407.   if (indexes == NoTree) return;
  408.   if (indexes->Kind == kDIMENSION_DECL) {
  409. # line 229 "ChangeDefs.puma"
  410.   {
  411. # line 230 "ChangeDefs.puma"
  412.    SetDeclDimension (decl, indexes->DIMENSION_DECL.INDEXES);
  413.   }
  414.    return;
  415.  
  416.   }
  417.   if (decl->Kind == kVAR_DECL) {
  418. # line 233 "ChangeDefs.puma"
  419.   {
  420. # line 234 "ChangeDefs.puma"
  421.  decl->VAR_DECL.VAL = mARRAY_TYPE (indexes, decl->VAR_DECL.VAL);
  422.   }
  423.    return;
  424.  
  425.   }
  426.   if (decl->Kind == kVAR_PARAM_DECL) {
  427. # line 237 "ChangeDefs.puma"
  428.   {
  429. # line 238 "ChangeDefs.puma"
  430.  decl->VAR_PARAM_DECL.VAL = mARRAY_TYPE (indexes, decl->VAR_PARAM_DECL.VAL);
  431.   }
  432.    return;
  433.  
  434.   }
  435. # line 241 "ChangeDefs.puma"
  436.   {
  437. # line 242 "ChangeDefs.puma"
  438.    printf ("Internal Error: SetDeclDimension fails\n");
  439.   }
  440.    return;
  441.  
  442. ;
  443. }
  444.  
  445. void MakeObjIntent
  446. # if defined __STDC__ | defined __cplusplus
  447. (register tDefinitions obj, register int intent)
  448. # else
  449. (obj, intent)
  450.  register tDefinitions obj;
  451.  register int intent;
  452. # endif
  453. {
  454.   if (obj == NoDefinitions) return;
  455.   if (obj->Kind == kVarObject) {
  456.   if (obj->VarObject.Kind->Kind == kVarDummy) {
  457. # line 253 "ChangeDefs.puma"
  458.   {
  459. # line 254 "ChangeDefs.puma"
  460.  if (obj->VarObject.Kind->VarDummy.Intent != -1)
  461.        obj_error_protocol ("Object has already INTENT attribute", obj);
  462.      obj->VarObject.Kind->VarDummy.Intent = intent;
  463.   }
  464.    return;
  465.  
  466.   }
  467.   }
  468. # line 259 "ChangeDefs.puma"
  469.   {
  470. # line 260 "ChangeDefs.puma"
  471.    obj_error_protocol ("this object can not have INTENT attribute", obj);
  472.   }
  473.    return;
  474.  
  475. ;
  476. }
  477.  
  478. void MakeObjOptional
  479. # if defined __STDC__ | defined __cplusplus
  480. (register tDefinitions obj)
  481. # else
  482. (obj)
  483.  register tDefinitions obj;
  484. # endif
  485. {
  486.   if (obj == NoDefinitions) return;
  487.   if (obj->Kind == kVarObject) {
  488.   if (obj->VarObject.Kind->Kind == kVarDummy) {
  489. # line 271 "ChangeDefs.puma"
  490.   {
  491. # line 272 "ChangeDefs.puma"
  492.    obj_error_protocol ("Object has already OPTIONAL attribute", obj);
  493.   }
  494.    return;
  495.  
  496.   }
  497.   }
  498. # line 279 "ChangeDefs.puma"
  499.   {
  500. # line 280 "ChangeDefs.puma"
  501.    obj_error_protocol ("this object can not be optional", obj);
  502.   }
  503.    return;
  504.  
  505. ;
  506. }
  507.  
  508. void MakeObjCommon
  509. # if defined __STDC__ | defined __cplusplus
  510. (register tTree decl, register tDefinitions obj)
  511. # else
  512. (decl, obj)
  513.  register tTree decl;
  514.  register tDefinitions obj;
  515. # endif
  516. {
  517. # line 291 "ChangeDefs.puma"
  518.  char string [100], msg[150];
  519.   if (decl == NoTree) return;
  520.   if (obj == NoDefinitions) return;
  521.   if (decl->Kind == kCOMMON_DECL) {
  522.   if (obj->Kind == kVarObject) {
  523.   if (obj->VarObject.Kind->Kind == kVarLocal) {
  524. # line 293 "ChangeDefs.puma"
  525.   {
  526. # line 295 "ChangeDefs.puma"
  527.    GetString (obj->VarObject.ident, string);
  528. # line 296 "ChangeDefs.puma"
  529.  if (obj->VarObject.Kind->VarLocal.IsSave != 0)
  530.         { obj_error_protocol ("Save Variabe not in COMMON : ", obj);
  531.           tree_protocol ("Declaration is : ", decl);
  532.         }
  533.       if (obj->VarObject.Kind->VarLocal.dynamic != 0)
  534.         { obj_error_protocol ("Dynamic Variabe not in COMMON : ", obj);
  535.           tree_protocol ("Declaration is : ", decl);
  536.         }
  537.  
  538. # line 305 "ChangeDefs.puma"
  539.    obj->VarObject.Kind = mVarCommon (decl->COMMON_DECL.Name);
  540.   }
  541.    return;
  542.  
  543.   }
  544.   if (obj->VarObject.Kind->Kind == kVarDummy) {
  545. # line 308 "ChangeDefs.puma"
  546.   {
  547. # line 310 "ChangeDefs.puma"
  548.    obj_error_protocol ("Dummy variable must not be in COMMON: ", obj);
  549. # line 311 "ChangeDefs.puma"
  550.    tree_protocol ("COMMON is : ", decl);
  551.   }
  552.    return;
  553.  
  554.   }
  555.   if (obj->VarObject.Kind->Kind == kVarCommon) {
  556. # line 314 "ChangeDefs.puma"
  557.   {
  558. # line 316 "ChangeDefs.puma"
  559.    GetString (obj->VarObject.Kind->VarCommon.Block, string);
  560. # line 317 "ChangeDefs.puma"
  561.    sprintf (msg, "Variable is already in COMMON %s : ", string);
  562. # line 318 "ChangeDefs.puma"
  563.    tree_error_protocol (msg, obj->VarObject.decl);
  564. # line 319 "ChangeDefs.puma"
  565.    tree_protocol ("New COMMON is : ", decl);
  566.   }
  567.    return;
  568.  
  569.   }
  570.   if (obj->VarObject.Kind->Kind == kVarConstant) {
  571. # line 322 "ChangeDefs.puma"
  572.   {
  573. # line 324 "ChangeDefs.puma"
  574.    tree_error_protocol ("Constant must not be in COMMON: ", obj->VarObject.decl);
  575. # line 325 "ChangeDefs.puma"
  576.    tree_protocol ("COMMON is : ", decl);
  577.   }
  578.    return;
  579.  
  580.   }
  581.   }
  582.   }
  583. # line 328 "ChangeDefs.puma"
  584.   {
  585. # line 329 "ChangeDefs.puma"
  586.    obj_error_protocol ("Object", obj);
  587. # line 330 "ChangeDefs.puma"
  588.    tree_protocol ("object must not be in this COMMON", decl);
  589.   }
  590.    return;
  591.  
  592. ;
  593. }
  594.  
  595. static tTree TreeTypeCombine
  596. # if defined __STDC__ | defined __cplusplus
  597. (register tTree d1, register tTree d2)
  598. # else
  599. (d1, d2)
  600.  register tTree d1;
  601.  register tTree d2;
  602. # endif
  603. {
  604. # line 344 "ChangeDefs.puma"
  605.  
  606. tTree newtype;
  607.  
  608.   if (d1->Kind == kDUMMY_TYPE) {
  609. # line 348 "ChangeDefs.puma"
  610.    return d2;
  611.  
  612.   }
  613.   if (d2->Kind == kDUMMY_TYPE) {
  614. # line 352 "ChangeDefs.puma"
  615.    return d1;
  616.  
  617.   }
  618.   if (d1->Kind == kARRAY_TYPE) {
  619.   if (d2->Kind == kARRAY_TYPE) {
  620. # line 356 "ChangeDefs.puma"
  621.   {
  622. # line 357 "ChangeDefs.puma"
  623.    printf ("**Error** : two array definitions\n");
  624.   }
  625.    return NoTree;
  626.  
  627.   }
  628.   if (d1->ARRAY_TYPE.ARRAY_COMP_TYPE->Kind == kDUMMY_TYPE) {
  629. # line 366 "ChangeDefs.puma"
  630.   {
  631. # line 367 "ChangeDefs.puma"
  632.  newtype = mARRAY_TYPE (d1->ARRAY_TYPE.ARRAY_INDEX_TYPES, d2);
  633.   }
  634.    return newtype;
  635.  
  636.   }
  637.   }
  638.   if (d2->Kind == kARRAY_TYPE) {
  639.   if (d2->ARRAY_TYPE.ARRAY_COMP_TYPE->Kind == kDUMMY_TYPE) {
  640. # line 361 "ChangeDefs.puma"
  641.   {
  642. # line 362 "ChangeDefs.puma"
  643.  newtype = mARRAY_TYPE (d2->ARRAY_TYPE.ARRAY_INDEX_TYPES, d1);
  644.   }
  645.    return newtype;
  646.  
  647.   }
  648.   }
  649. # line 371 "ChangeDefs.puma"
  650.    return NoTree;
  651.  
  652. }
  653.  
  654. void MakeObjSequential
  655. # if defined __STDC__ | defined __cplusplus
  656. (register tTree t, register tDefinitions v)
  657. # else
  658. (t, v)
  659.  register tTree t;
  660.  register tDefinitions v;
  661. # endif
  662. {
  663.   if (t == NoTree) return;
  664.   if (v == NoDefinitions) return;
  665.   if (v->Kind == kCommonObject) {
  666. # line 383 "ChangeDefs.puma"
  667.   {
  668. # line 384 "ChangeDefs.puma"
  669.    if (! ((v->CommonObject.sequence == 2))) goto yyL1;
  670.   {
  671. # line 385 "ChangeDefs.puma"
  672.    tree_error_protocol ("COMMON has already NO SEQUENCE association", t);
  673.   }
  674.   }
  675.    return;
  676. yyL1:;
  677.  
  678. # line 388 "ChangeDefs.puma"
  679.   {
  680. # line 389 "ChangeDefs.puma"
  681.    if (! ((v->CommonObject.distributed_vars > 0))) goto yyL2;
  682.   {
  683. # line 391 "ChangeDefs.puma"
  684.    tree_error_protocol ("COMMON with distributed arrays must not have SEQUENCE association", t);
  685.   }
  686.   }
  687.    return;
  688. yyL2:;
  689.  
  690. # line 394 "ChangeDefs.puma"
  691.   {
  692. # line 395 "ChangeDefs.puma"
  693.  v->CommonObject.sequence = 1;
  694.   }
  695.    return;
  696.  
  697.   }
  698. ;
  699. }
  700.  
  701. void MakeObjNoSequential
  702. # if defined __STDC__ | defined __cplusplus
  703. (register tTree t, register tDefinitions v)
  704. # else
  705. (t, v)
  706.  register tTree t;
  707.  register tDefinitions v;
  708. # endif
  709. {
  710.   if (t == NoTree) return;
  711.   if (v == NoDefinitions) return;
  712.   if (v->Kind == kCommonObject) {
  713. # line 406 "ChangeDefs.puma"
  714.   {
  715. # line 407 "ChangeDefs.puma"
  716.    if (! ((v->CommonObject.sequence == 1))) goto yyL1;
  717.   {
  718. # line 408 "ChangeDefs.puma"
  719.    tree_error_protocol ("COMMON has already SEQUENCE association", t);
  720.   }
  721.   }
  722.    return;
  723. yyL1:;
  724.  
  725. # line 411 "ChangeDefs.puma"
  726.   {
  727. # line 412 "ChangeDefs.puma"
  728.  v->CommonObject.sequence = 2;
  729.   }
  730.    return;
  731.  
  732.   }
  733. ;
  734. }
  735.  
  736. void MakeObjSave
  737. # if defined __STDC__ | defined __cplusplus
  738. (register tTree t, register tDefinitions v)
  739. # else
  740. (t, v)
  741.  register tTree t;
  742.  register tDefinitions v;
  743. # endif
  744. {
  745.   if (t == NoTree) return;
  746.   if (v == NoDefinitions) return;
  747.   if (v->Kind == kVarObject) {
  748.   if (v->VarObject.Kind->Kind == kVarLocal) {
  749. # line 423 "ChangeDefs.puma"
  750.   {
  751. # line 424 "ChangeDefs.puma"
  752.  if (v->VarObject.Kind->VarLocal.IsSave)
  753.        tree_error_protocol ("Local Variable is already save", t);
  754.      v->VarObject.Kind->VarLocal.IsSave = true;
  755.  
  756.   }
  757.    return;
  758.  
  759.   }
  760.   if (v->VarObject.Kind->Kind == kVarDummy) {
  761. # line 430 "ChangeDefs.puma"
  762.   {
  763. # line 431 "ChangeDefs.puma"
  764.    tree_error_protocol ("Dummy variable can not be save", t);
  765.   }
  766.    return;
  767.  
  768.   }
  769.   if (v->VarObject.Kind->Kind == kVarConstant) {
  770. # line 434 "ChangeDefs.puma"
  771.   {
  772. # line 435 "ChangeDefs.puma"
  773.    tree_error_protocol ("Constant can not be save", t);
  774.   }
  775.    return;
  776.  
  777.   }
  778.   if (v->VarObject.Kind->Kind == kVarCommon) {
  779. # line 438 "ChangeDefs.puma"
  780.   {
  781. # line 439 "ChangeDefs.puma"
  782.    tree_error_protocol ("only a whole common block can be save", t);
  783.   }
  784.    return;
  785.  
  786.   }
  787.   }
  788. # line 442 "ChangeDefs.puma"
  789.   {
  790. # line 443 "ChangeDefs.puma"
  791.    tree_error_protocol ("subroutine/function/blockdata cannot be save", t);
  792.   }
  793.    return;
  794.  
  795. ;
  796. }
  797.  
  798. void MakeObjDistribution
  799. # if defined __STDC__ | defined __cplusplus
  800. (register tTree layout, register tDefinitions obj)
  801. # else
  802. (layout, obj)
  803.  register tTree layout;
  804.  register tDefinitions obj;
  805. # endif
  806. {
  807.   if (layout == NoTree) return;
  808.   if (obj == NoDefinitions) return;
  809.   if (layout->Kind == kDISTRIBUTE_DECL) {
  810.   if (obj->Kind == kVarObject) {
  811.   if (obj->VarObject.Dist->Kind == kDefaultDistribution) {
  812. # line 456 "ChangeDefs.puma"
  813.   {
  814. # line 459 "ChangeDefs.puma"
  815.    CheckDistributionSpecification (layout, VarRank (obj));
  816. # line 460 "ChangeDefs.puma"
  817.  obj->VarObject.Dist = GetDistribution (layout->DISTRIBUTE_DECL.DISTRIBUTION);
  818.   }
  819.    return;
  820.  
  821.   }
  822.   }
  823.   if (obj->Kind == kTemplateObject) {
  824.   if (obj->TemplateObject.Dist->Kind == kDefaultDistribution) {
  825. # line 468 "ChangeDefs.puma"
  826.   {
  827. # line 471 "ChangeDefs.puma"
  828.    CheckDistributionSpecification (layout, VarRank (obj));
  829. # line 473 "ChangeDefs.puma"
  830.  obj->TemplateObject.Dist = GetDistribution (layout->DISTRIBUTE_DECL.DISTRIBUTION);
  831.   }
  832.    return;
  833.  
  834.   }
  835.   }
  836.   }
  837.   if (obj->Kind == kVarObject) {
  838. # line 463 "ChangeDefs.puma"
  839.   {
  840. # line 464 "ChangeDefs.puma"
  841.    obj_error_protocol ("this variable object is already distributed", obj);
  842. # line 465 "ChangeDefs.puma"
  843.    tree_protocol ("new distribution is : ", layout);
  844.   }
  845.    return;
  846.  
  847.   }
  848.   if (obj->Kind == kTemplateObject) {
  849. # line 476 "ChangeDefs.puma"
  850.   {
  851. # line 477 "ChangeDefs.puma"
  852.    obj_error_protocol ("this template object is already distributed", obj);
  853. # line 478 "ChangeDefs.puma"
  854.    tree_protocol ("new distribution is : ", layout);
  855.   }
  856.    return;
  857.  
  858.   }
  859. # line 481 "ChangeDefs.puma"
  860.   {
  861. # line 482 "ChangeDefs.puma"
  862.    obj_error_protocol ("this object cannot be distributed", obj);
  863. # line 483 "ChangeDefs.puma"
  864.    tree_protocol ("layout/distribution is : ", layout);
  865.   }
  866.    return;
  867.  
  868. ;
  869. }
  870.  
  871. static void CheckDistributionSpecification
  872. # if defined __STDC__ | defined __cplusplus
  873. (register tTree layout, register int rank)
  874. # else
  875. (layout, rank)
  876.  register tTree layout;
  877.  register int rank;
  878. # endif
  879. {
  880.   if (layout == NoTree) return;
  881.   if (layout->Kind == kDISTRIBUTE_DECL) {
  882.   if (layout->DISTRIBUTE_DECL.DISTRIBUTION->Kind == kNODE_DISTRIBUTION) {
  883. # line 494 "ChangeDefs.puma"
  884.   {
  885. # line 495 "ChangeDefs.puma"
  886.  if (TreeListLength (layout->DISTRIBUTE_DECL.DISTRIBUTION->NODE_DISTRIBUTION.MAPPING) != rank)
  887.        tree_error_protocol ("illegal distribution (rank!)", layout);
  888.     if (rank == 0)
  889.        tree_error_protocol ("distribution of a scalar not allowed", layout);
  890.  
  891.   }
  892.    return;
  893.  
  894.   }
  895.   }
  896. # line 502 "ChangeDefs.puma"
  897.   {
  898. # line 503 "ChangeDefs.puma"
  899.  if (rank == 0)
  900.        tree_error_protocol ("distribution of a scalar not allowed", layout);
  901.  
  902.   }
  903.    return;
  904.  
  905. ;
  906. }
  907.  
  908. static tDefinitions GetDistribution
  909. # if defined __STDC__ | defined __cplusplus
  910. (register tTree t)
  911. # else
  912. (t)
  913.  register tTree t;
  914. # endif
  915. {
  916.   if (t->Kind == kHOST_DISTRIBUTION) {
  917. # line 516 "ChangeDefs.puma"
  918.    return mHostDistribution (0, 0, DefaultId ());
  919.  
  920.   }
  921.   if (t->Kind == kREPL_DISTRIBUTION) {
  922. # line 520 "ChangeDefs.puma"
  923.    return mSerialDistribution (0, 0);
  924.  
  925.   }
  926.   if (t->Kind == kNODE_DISTRIBUTION) {
  927. # line 524 "ChangeDefs.puma"
  928.   {
  929. # line 525 "ChangeDefs.puma"
  930.    if (! ((target_model == UNI_PROC))) goto yyL3;
  931.   }
  932.    return mSerialDistribution (0, 0);
  933. yyL3:;
  934.  
  935. # line 529 "ChangeDefs.puma"
  936.   {
  937. # line 530 "ChangeDefs.puma"
  938.    if (! (IsSerialDistribution (t->NODE_DISTRIBUTION.MAPPING) == true)) goto yyL4;
  939.   }
  940.    return mSerialDistribution (0, 0);
  941. yyL4:;
  942.  
  943. # line 534 "ChangeDefs.puma"
  944.    return mNodeDistribution (0, 0, DefaultId (), GetDistributedDimensions (t->NODE_DISTRIBUTION.MAPPING, 0));
  945.  
  946.   }
  947. # line 539 "ChangeDefs.puma"
  948.   {
  949. # line 540 "ChangeDefs.puma"
  950.    tree_error_protocol ("Illegal distribution specification", t);
  951.   }
  952.    return 0;
  953.  
  954. }
  955.  
  956. static bool IsSerialDistribution
  957. # if defined __STDC__ | defined __cplusplus
  958. (register tTree t)
  959. # else
  960. (t)
  961.  register tTree t;
  962. # endif
  963. {
  964.   if (t == NoTree) return false;
  965.   if (t->Kind == kDIST_EMPTY) {
  966. # line 554 "ChangeDefs.puma"
  967.    return true;
  968.  
  969.   }
  970.   if (t->Kind == kDIST_LIST) {
  971.   if (t->DIST_LIST.Elem->Kind == kSERIAL_DISTRIBUTION) {
  972. # line 557 "ChangeDefs.puma"
  973.   {
  974. # line 558 "ChangeDefs.puma"
  975.    if (! (IsSerialDistribution (t->DIST_LIST.Next))) goto yyL2;
  976.   }
  977.    return true;
  978. yyL2:;
  979.  
  980.   }
  981.   }
  982.   return false;
  983. }
  984.  
  985. static DistributedDimensions GetDistributedDimensions
  986. # if defined __STDC__ | defined __cplusplus
  987. (register tTree t, register int n)
  988. # else
  989. (t, n)
  990.  register tTree t;
  991.  register int n;
  992. # endif
  993. {
  994. # line 574 "ChangeDefs.puma"
  995.  
  996. DistributedDimensions dims;
  997.  
  998.   if (t->Kind == kDIST_EMPTY) {
  999. # line 578 "ChangeDefs.puma"
  1000.   {
  1001. # line 579 "ChangeDefs.puma"
  1002.  dims.no_dims = n;
  1003.   }
  1004.    return dims;
  1005.  
  1006.   }
  1007.   if (t->Kind == kDIST_LIST) {
  1008.   if (t->DIST_LIST.Elem->Kind == kSERIAL_DISTRIBUTION) {
  1009. # line 583 "ChangeDefs.puma"
  1010.   {
  1011. # line 584 "ChangeDefs.puma"
  1012.  dims = GetDistributedDimensions (t->DIST_LIST.Next, n+1);
  1013.      dims.DimsArray[n] = 0;
  1014.  
  1015.   }
  1016.    return dims;
  1017.  
  1018.   }
  1019.   if (t->DIST_LIST.Elem->Kind == kBLOCK_DISTRIBUTION) {
  1020. # line 590 "ChangeDefs.puma"
  1021.   {
  1022. # line 591 "ChangeDefs.puma"
  1023.  dims = GetDistributedDimensions (t->DIST_LIST.Next, n+1);
  1024.      dims.DimsArray[n] = 1;
  1025.  
  1026.   }
  1027.    return dims;
  1028.  
  1029.   }
  1030.   if (t->DIST_LIST.Elem->Kind == kCYCLIC_DISTRIBUTION) {
  1031. # line 597 "ChangeDefs.puma"
  1032.   {
  1033. # line 598 "ChangeDefs.puma"
  1034.  dims = GetDistributedDimensions (t->DIST_LIST.Next, n+1);
  1035.      dims.DimsArray[n] = 2;
  1036.  
  1037.   }
  1038.    return dims;
  1039.  
  1040.   }
  1041.   }
  1042.  yyAbort ("GetDistributedDimensions");
  1043. }
  1044.  
  1045. void MakeObjAlignment
  1046. # if defined __STDC__ | defined __cplusplus
  1047. (register tTree align, register tDefinitions obj)
  1048. # else
  1049. (align, obj)
  1050.  register tTree align;
  1051.  register tDefinitions obj;
  1052. # endif
  1053. {
  1054.   if (align == NoTree) return;
  1055.   if (obj == NoDefinitions) return;
  1056.   if (align->Kind == kALIGN_DECL) {
  1057.   if (obj->Kind == kVarObject) {
  1058.   if (obj->VarObject.Dist->Kind == kDefaultDistribution) {
  1059. # line 612 "ChangeDefs.puma"
  1060.   {
  1061. # line 615 "ChangeDefs.puma"
  1062.  if (VarRank(obj) == 0)
  1063.        obj_error_protocol ("alignment for scalars not allowed", obj);
  1064.     obj->VarObject.Dist = GetAlignDistribution (align, VarRank(obj));
  1065.  
  1066.   }
  1067.    return;
  1068.  
  1069.   }
  1070.   }
  1071.   }
  1072.   if (obj->Kind == kVarObject) {
  1073. # line 621 "ChangeDefs.puma"
  1074.   {
  1075. # line 622 "ChangeDefs.puma"
  1076.    obj_error_protocol ("this variable object is already distributed", obj);
  1077.   }
  1078.    return;
  1079.  
  1080.   }
  1081. # line 625 "ChangeDefs.puma"
  1082.   {
  1083. # line 626 "ChangeDefs.puma"
  1084.    obj_error_protocol ("this object cannot be distributed", obj);
  1085.   }
  1086.    return;
  1087.  
  1088. ;
  1089. }
  1090.  
  1091. static tDefinitions GetAlignDistribution
  1092. # if defined __STDC__ | defined __cplusplus
  1093. (register tTree align, register int rank)
  1094. # else
  1095. (align, rank)
  1096.  register tTree align;
  1097.  register int rank;
  1098. # endif
  1099. {
  1100.   if (align->Kind == kALIGN_DECL) {
  1101. # line 641 "ChangeDefs.puma"
  1102.  {
  1103.   int n1;
  1104.   int n2;
  1105.   {
  1106. # line 643 "ChangeDefs.puma"
  1107.    GenFullAlignSource (align, rank);
  1108. # line 644 "ChangeDefs.puma"
  1109.    GenFullAlignSpec (align);
  1110. # line 646 "ChangeDefs.puma"
  1111.  
  1112. # line 647 "ChangeDefs.puma"
  1113.  
  1114. # line 649 "ChangeDefs.puma"
  1115.  n1 = FillAlignSpec (align->ALIGN_DECL.ALIGN_SOURCE,0);
  1116.      n2 = FillAlignSpec (align->ALIGN_DECL.ALIGN_SPEC,0);
  1117.      if (n1 != n2)
  1118.         tree_error_protocol ("align: mismatch of source and spec", align);
  1119.  
  1120.   }
  1121.   {
  1122.    return MakeAlignDistribution (align->ALIGN_DECL.ALIGN_SPEC, align->ALIGN_DECL.ALIGN_SOURCE);
  1123.   }
  1124.  }
  1125.  
  1126.   }
  1127.  yyAbort ("GetAlignDistribution");
  1128. }
  1129.  
  1130. static tDefinitions MakeAlignDistribution
  1131. # if defined __STDC__ | defined __cplusplus
  1132. (register tTree template, register tTree source)
  1133. # else
  1134. (template, source)
  1135.  register tTree template;
  1136.  register tTree source;
  1137. # endif
  1138. {
  1139.   if (template->Kind == kINDEXED_VAR) {
  1140.   if (template->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
  1141. # line 670 "ChangeDefs.puma"
  1142.    return mAlignDistribution (0, 0, template->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Object, FindAllSourceDimensions (template->INDEXED_VAR.IND_EXPS, source, 0));
  1143.  
  1144.   }
  1145.   }
  1146.  yyAbort ("MakeAlignDistribution");
  1147. }
  1148.  
  1149. static void GenFullAlignSource
  1150. # if defined __STDC__ | defined __cplusplus
  1151. (register tTree align, register int rank)
  1152. # else
  1153. (align, rank)
  1154.  register tTree align;
  1155.  register int rank;
  1156. # endif
  1157. {
  1158. # line 686 "ChangeDefs.puma"
  1159.  
  1160. int i;
  1161. tTree hs, slice;
  1162.  
  1163.   if (align == NoTree) return;
  1164.   if (align->Kind == kALIGN_DECL) {
  1165.   if (align->ALIGN_DECL.ALIGN_SOURCE->Kind == kBTE_EMPTY) {
  1166. # line 691 "ChangeDefs.puma"
  1167.   {
  1168. # line 692 "ChangeDefs.puma"
  1169.  hs = align->ALIGN_DECL.ALIGN_SOURCE;
  1170.      slice = mSLICE_EXP (mDUMMY_EXP(), mDUMMY_EXP(), mDUMMY_EXP());
  1171.      for (i=1; i<= rank; i++)
  1172.        hs = mBTE_LIST (slice, hs);
  1173.      align->ALIGN_DECL.ALIGN_SOURCE = hs;
  1174.  
  1175.   }
  1176.    return;
  1177.  
  1178.   }
  1179. # line 700 "ChangeDefs.puma"
  1180.   {
  1181. # line 701 "ChangeDefs.puma"
  1182.  if (TreeListLength (align->ALIGN_DECL.ALIGN_SOURCE) != rank)
  1183.         tree_error_protocol ("illegal align source list, rank ! ", align);
  1184.  
  1185.   }
  1186.    return;
  1187.  
  1188.   }
  1189. ;
  1190. }
  1191.  
  1192. static void GenFullAlignSpec
  1193. # if defined __STDC__ | defined __cplusplus
  1194. (register tTree align)
  1195. # else
  1196. (align)
  1197.  register tTree align;
  1198. # endif
  1199. {
  1200. # line 716 "ChangeDefs.puma"
  1201.  
  1202. int i, rank;
  1203. tTree list, slice;
  1204.  
  1205.   if (align == NoTree) return;
  1206.   if (align->Kind == kALIGN_DECL) {
  1207.   if (align->ALIGN_DECL.ALIGN_SPEC->Kind == kUSED_VAR) {
  1208. # line 721 "ChangeDefs.puma"
  1209.   {
  1210. # line 722 "ChangeDefs.puma"
  1211.  if (!CorrectAlignSpec (align->ALIGN_DECL.ALIGN_SPEC))
  1212.       { tree_protocol ("alignment is : ", align);
  1213.         rank = 0;
  1214.       }
  1215.      else
  1216.         rank = TreeRank (align->ALIGN_DECL.ALIGN_SPEC);
  1217.     list = mBTE_EMPTY ();
  1218.     slice = mSLICE_EXP (mDUMMY_EXP(), mDUMMY_EXP(), mDUMMY_EXP());
  1219.     for (i=1; i<=rank; i++)
  1220.       list = mBTE_LIST (slice, list);
  1221.     align->ALIGN_DECL.ALIGN_SPEC = mINDEXED_VAR (align->ALIGN_DECL.ALIGN_SPEC, list);
  1222.  
  1223.   }
  1224.    return;
  1225.  
  1226.   }
  1227.   if (align->ALIGN_DECL.ALIGN_SPEC->Kind == kINDEXED_VAR) {
  1228. # line 736 "ChangeDefs.puma"
  1229.   {
  1230. # line 737 "ChangeDefs.puma"
  1231.  if (!CorrectAlignSpec (align->ALIGN_DECL.ALIGN_SPEC))
  1232.       tree_protocol ("alignment is : ", align);
  1233.      else if (TreeListLength (align->ALIGN_DECL.ALIGN_SPEC->INDEXED_VAR.IND_EXPS) != TreeRank (align->ALIGN_DECL.ALIGN_SPEC->INDEXED_VAR.IND_VAR))
  1234.       tree_error_protocol ("illegal spec in alignment (rank!)", align);
  1235.  
  1236.   }
  1237.    return;
  1238.  
  1239.   }
  1240.   }
  1241. # line 744 "ChangeDefs.puma"
  1242.   {
  1243. # line 745 "ChangeDefs.puma"
  1244.    fprintf (stderr, "ChangeDefs: GenFullAlignSpec fails\n");
  1245. # line 746 "ChangeDefs.puma"
  1246.    WriteTree (stderr, align);
  1247. # line 747 "ChangeDefs.puma"
  1248.    kill_in_protocol ();
  1249.   }
  1250.    return;
  1251.  
  1252. ;
  1253. }
  1254.  
  1255. static bool CorrectAlignSpec
  1256. # if defined __STDC__ | defined __cplusplus
  1257. (register tTree align)
  1258. # else
  1259. (align)
  1260.  register tTree align;
  1261. # endif
  1262. {
  1263.   if (align->Kind == kUSED_VAR) {
  1264. # line 760 "ChangeDefs.puma"
  1265.  {
  1266.   tDefinitions Obj;
  1267.   bool ok;
  1268.   {
  1269. # line 762 "ChangeDefs.puma"
  1270.  
  1271. # line 763 "ChangeDefs.puma"
  1272.  
  1273. # line 765 "ChangeDefs.puma"
  1274.    Obj = GetLocalDecl (align->USED_VAR.VARNAME->VAR_OBJ.Ident);
  1275. # line 767 "ChangeDefs.puma"
  1276.  ok = false;
  1277.     if (Obj == NoObject)
  1278.        simple_error_protocol ("align: spec name not defined");
  1279.      else if (Obj->Kind != kTemplateObject)
  1280.        simple_error_protocol ("align: spec not a template");
  1281.      else
  1282.        { align->USED_VAR.VARNAME->VAR_OBJ.Object = Obj;
  1283.          ok = true;
  1284.        }
  1285.  
  1286.   }
  1287.   {
  1288.    return ok;
  1289.   }
  1290.  }
  1291.  
  1292.   }
  1293.   if (align->Kind == kINDEXED_VAR) {
  1294. # line 780 "ChangeDefs.puma"
  1295.    return CorrectAlignSpec (align->INDEXED_VAR.IND_VAR);
  1296.  
  1297.   }
  1298.  yyAbort ("CorrectAlignSpec");
  1299. }
  1300.  
  1301. static int FillAlignSpec
  1302. # if defined __STDC__ | defined __cplusplus
  1303. (register tTree t, register int n)
  1304. # else
  1305. (t, n)
  1306.  register tTree t;
  1307.  register int n;
  1308. # endif
  1309. {
  1310. # line 799 "ChangeDefs.puma"
  1311.  
  1312. char name [20];
  1313.  
  1314.   if (t->Kind == kINDEXED_VAR) {
  1315. # line 803 "ChangeDefs.puma"
  1316.    return FillAlignSpec (t->INDEXED_VAR.IND_EXPS, n);
  1317.  
  1318.   }
  1319.   if (t->Kind == kBTE_EMPTY) {
  1320. # line 807 "ChangeDefs.puma"
  1321.    return n;
  1322.  
  1323.   }
  1324.   if (t->Kind == kBTE_LIST) {
  1325.   if (t->BTE_LIST.Elem->Kind == kSLICE_EXP) {
  1326.   if (t->BTE_LIST.Elem->SLICE_EXP.START->Kind == kDUMMY_EXP) {
  1327.   if (t->BTE_LIST.Elem->SLICE_EXP.STOP->Kind == kDUMMY_EXP) {
  1328.   if (t->BTE_LIST.Elem->SLICE_EXP.INC->Kind == kDUMMY_EXP) {
  1329. # line 811 "ChangeDefs.puma"
  1330.  {
  1331.   tTree e;
  1332.   {
  1333. # line 813 "ChangeDefs.puma"
  1334.  
  1335. # line 815 "ChangeDefs.puma"
  1336.  sprintf (name, "I_%d", n+1);
  1337.      e = mVAR_OBJ (0, MakeIdent (name, strlen (name)));
  1338.      e = mVAR_EXP (mUSED_VAR (e));
  1339.      t->BTE_LIST.Elem = e;
  1340.  
  1341.   }
  1342.   {
  1343.    return FillAlignSpec (t->BTE_LIST.Next, n + 1);
  1344.   }
  1345.  }
  1346.  
  1347.   }
  1348.   }
  1349.   }
  1350.   }
  1351. # line 823 "ChangeDefs.puma"
  1352.    return FillAlignSpec (t->BTE_LIST.Next, n);
  1353.  
  1354.   }
  1355. # line 827 "ChangeDefs.puma"
  1356.   {
  1357. # line 828 "ChangeDefs.puma"
  1358.    printf ("FillAlignSpec in ChangeDefs failed\n");
  1359. # line 829 "ChangeDefs.puma"
  1360.    WriteTree (stdout, t);
  1361. # line 830 "ChangeDefs.puma"
  1362.    kill_in_protocol ();
  1363.   }
  1364.    return n;
  1365.  
  1366. }
  1367.  
  1368. static DistributedDimensions FindAllSourceDimensions
  1369. # if defined __STDC__ | defined __cplusplus
  1370. (register tTree spec, register tTree source, register int n)
  1371. # else
  1372. (spec, source, n)
  1373.  register tTree spec;
  1374.  register tTree source;
  1375.  register int n;
  1376. # endif
  1377. {
  1378. # line 846 "ChangeDefs.puma"
  1379.  
  1380. DistributedDimensions dims;
  1381.  
  1382.   if (spec->Kind == kBTE_EMPTY) {
  1383. # line 850 "ChangeDefs.puma"
  1384.   {
  1385. # line 851 "ChangeDefs.puma"
  1386.  dims.no_dims = n;
  1387.   }
  1388.    return dims;
  1389.  
  1390.   }
  1391.   if (spec->Kind == kBTE_LIST) {
  1392. # line 855 "ChangeDefs.puma"
  1393.   {
  1394. # line 856 "ChangeDefs.puma"
  1395.  dims = FindAllSourceDimensions (spec->BTE_LIST.Next, source, n+1);
  1396.      dims.DimsArray[n] = FindSourceDimension (spec->BTE_LIST.Elem, source, 1);
  1397.  
  1398.   }
  1399.    return dims;
  1400.  
  1401.   }
  1402.  yyAbort ("FindAllSourceDimensions");
  1403. }
  1404.  
  1405. static int FindSourceDimension
  1406. # if defined __STDC__ | defined __cplusplus
  1407. (register tTree spec, register tTree source, register int n)
  1408. # else
  1409. (spec, source, n)
  1410.  register tTree spec;
  1411.  register tTree source;
  1412.  register int n;
  1413. # endif
  1414. {
  1415.   if (spec->Kind == kDUMMY_EXP) {
  1416. # line 878 "ChangeDefs.puma"
  1417.    return 0;
  1418.  
  1419.   }
  1420.   if (source->Kind == kBTE_EMPTY) {
  1421. # line 882 "ChangeDefs.puma"
  1422.    return - 1;
  1423.  
  1424.   }
  1425.   if (spec->Kind == kVAR_EXP) {
  1426.   if (spec->VAR_EXP.V->Kind == kUSED_VAR) {
  1427.   if (source->Kind == kBTE_LIST) {
  1428.   if (source->BTE_LIST.Elem->Kind == kVAR_EXP) {
  1429.   if (source->BTE_LIST.Elem->VAR_EXP.V->Kind == kUSED_VAR) {
  1430. # line 886 "ChangeDefs.puma"
  1431.   {
  1432. # line 888 "ChangeDefs.puma"
  1433.    if (! (spec->VAR_EXP.V->USED_VAR.VARNAME->VAR_OBJ.Ident == source->BTE_LIST.Elem->VAR_EXP.V->USED_VAR.VARNAME->VAR_OBJ.Ident)) goto yyL3;
  1434.   }
  1435.    return n;
  1436. yyL3:;
  1437.  
  1438.   }
  1439.   }
  1440.   }
  1441.   }
  1442.   }
  1443.   if (source->Kind == kBTE_LIST) {
  1444. # line 892 "ChangeDefs.puma"
  1445.    return FindSourceDimension (spec, source->BTE_LIST.Next, n + 1);
  1446.  
  1447.   }
  1448.  yyAbort ("FindSourceDimension");
  1449. }
  1450.  
  1451. static tDefinitions GetExtFuncEntry
  1452. # if defined __STDC__ | defined __cplusplus
  1453. (register tIdent name, register tTree type)
  1454. # else
  1455. (name, type)
  1456.  register tIdent name;
  1457.  register tTree type;
  1458. # endif
  1459. {
  1460. # line 904 "ChangeDefs.puma"
  1461.  
  1462. tObject obj;
  1463. tTree   Decl;
  1464. int     calls;
  1465.  
  1466. # line 910 "ChangeDefs.puma"
  1467.   {
  1468. # line 911 "ChangeDefs.puma"
  1469.  obj = GetDeclEntry (name, GetUnitEntries ());
  1470.      if (obj == NoObject)
  1471.        obj = GetDeclEntry (name, GetExternalEntries ());
  1472.      if (obj == NoObject)
  1473.        {
  1474.          Decl = mEXT_FUNC_DECL (name, 0, mDECL_EMPTY(), type);
  1475.          calls = 0;
  1476.          obj = mFuncObject (name, Decl, calls, mENTRY_EMPTY ());
  1477.          InsertExternalEntry (obj);
  1478.        }
  1479.       else
  1480.        {
  1481.        }
  1482.  
  1483.   }
  1484.    return obj;
  1485.  
  1486. }
  1487.  
  1488. void MakeObjExternal
  1489. # if defined __STDC__ | defined __cplusplus
  1490. (register tTree decl, register tDefinitions oldobj)
  1491. # else
  1492. (decl, oldobj)
  1493.  register tTree decl;
  1494.  register tDefinitions oldobj;
  1495. # endif
  1496. {
  1497.   if (decl == NoTree) return;
  1498.   if (oldobj == NoDefinitions) return;
  1499.   if (oldobj->Kind == kVarObject) {
  1500.   if (oldobj->VarObject.decl->Kind == kVAR_DECL) {
  1501.   if (oldobj->VarObject.Kind->Kind == kVarLocal) {
  1502. # line 938 "ChangeDefs.puma"
  1503.  {
  1504.   tDefinitions Obj;
  1505.   {
  1506. # line 940 "ChangeDefs.puma"
  1507.  
  1508. # line 942 "ChangeDefs.puma"
  1509.    Obj = GetExtFuncEntry (oldobj->VarObject.ident, oldobj->VarObject.decl->VAR_DECL.VAL);
  1510. # line 946 "ChangeDefs.puma"
  1511.    ChangeEntry (oldobj->VarObject.ident, Obj);
  1512.   }
  1513.    return;
  1514.  }
  1515.  
  1516.   }
  1517.   }
  1518.   if (oldobj->VarObject.decl->Kind == kVAR_PARAM_DECL) {
  1519.   if (oldobj->VarObject.decl->VAR_PARAM_DECL.VAL->Kind == kDUMMY_TYPE) {
  1520. # line 956 "ChangeDefs.puma"
  1521.  {
  1522.   tDefinitions Obj;
  1523.   tTree ndecl;
  1524.   int calls;
  1525.   {
  1526. # line 958 "ChangeDefs.puma"
  1527.  
  1528. # line 959 "ChangeDefs.puma"
  1529.  
  1530. # line 960 "ChangeDefs.puma"
  1531.  
  1532. # line 962 "ChangeDefs.puma"
  1533.  ndecl   = mPROC_PARAM_DECL (oldobj->VarObject.ident, oldobj->VarObject.decl->VAR_PARAM_DECL.Pos, mBTP_EMPTY());
  1534.      calls  = 0;
  1535.      Obj    = mProcObject (oldobj->VarObject.ident, ndecl, calls, mENTRY_EMPTY ());
  1536.  
  1537. # line 967 "ChangeDefs.puma"
  1538.    ChangeEntry (oldobj->VarObject.ident, Obj);
  1539.   }
  1540.    return;
  1541.  }
  1542.  
  1543.   }
  1544. # line 978 "ChangeDefs.puma"
  1545.  {
  1546.   tDefinitions Obj;
  1547.   tTree ndecl;
  1548.   int calls;
  1549.   {
  1550. # line 980 "ChangeDefs.puma"
  1551.  
  1552. # line 981 "ChangeDefs.puma"
  1553.  
  1554. # line 982 "ChangeDefs.puma"
  1555.  
  1556. # line 984 "ChangeDefs.puma"
  1557.  ndecl  = mFUNC_PARAM_DECL (oldobj->VarObject.ident, oldobj->VarObject.decl->VAR_PARAM_DECL.Pos, mBTP_EMPTY(), oldobj->VarObject.decl->VAR_PARAM_DECL.VAL);
  1558.      calls  = 0;
  1559.      Obj    = mFuncObject (oldobj->VarObject.ident, ndecl, calls, mENTRY_EMPTY ());
  1560.  
  1561. # line 989 "ChangeDefs.puma"
  1562.    ChangeEntry (oldobj->VarObject.ident, Obj);
  1563.   }
  1564.    return;
  1565.  }
  1566.  
  1567.   }
  1568. # line 992 "ChangeDefs.puma"
  1569.   {
  1570. # line 993 "ChangeDefs.puma"
  1571.    tree_error_protocol ("could not make var to external", oldobj->VarObject.decl);
  1572.   }
  1573.    return;
  1574.  
  1575.   }
  1576.   if (oldobj->Kind == kProcObject) {
  1577. # line 996 "ChangeDefs.puma"
  1578.   {
  1579. # line 997 "ChangeDefs.puma"
  1580.    tree_error_protocol ("could not make proc to external", oldobj->ProcObject.decl);
  1581.   }
  1582.    return;
  1583.  
  1584.   }
  1585.   if (oldobj->Kind == kFuncObject) {
  1586. # line 1000 "ChangeDefs.puma"
  1587.   {
  1588. # line 1001 "ChangeDefs.puma"
  1589.    tree_error_protocol ("could not make func to external", oldobj->FuncObject.decl);
  1590.   }
  1591.    return;
  1592.  
  1593.   }
  1594.   if (oldobj->Kind == kBlockObject) {
  1595. # line 1004 "ChangeDefs.puma"
  1596.   {
  1597. # line 1005 "ChangeDefs.puma"
  1598.    tree_error_protocol ("could not make block to external", oldobj->BlockObject.decl);
  1599.   }
  1600.    return;
  1601.  
  1602.   }
  1603. ;
  1604. }
  1605.  
  1606. void StatementFunctions
  1607. # if defined __STDC__ | defined __cplusplus
  1608. (register tTree body)
  1609. # else
  1610. (body)
  1611.  register tTree body;
  1612. # endif
  1613. {
  1614.   if (body == NoTree) return;
  1615.   if (body->Kind == kBODY_NODE) {
  1616. # line 1016 "ChangeDefs.puma"
  1617.   {
  1618. # line 1018 "ChangeDefs.puma"
  1619.  
  1620.  
  1621.  
  1622.       stmtfuncs = mDECL_EMPTY ();
  1623.  
  1624.  
  1625.  
  1626.       body->BODY_NODE.STATS = ExtractStatementFunctions (body->BODY_NODE.STATS);
  1627.  
  1628.       body->BODY_NODE.DECLS = AppendDECLS (body->BODY_NODE.DECLS, stmtfuncs);
  1629.  
  1630.  
  1631.   }
  1632.    return;
  1633.  
  1634.   }
  1635. ;
  1636. }
  1637.  
  1638. static tTree ExtractStatementFunctions
  1639. # if defined __STDC__ | defined __cplusplus
  1640. (register tTree t)
  1641. # else
  1642. (t)
  1643.  register tTree t;
  1644. # endif
  1645. {
  1646. # line 1040 "ChangeDefs.puma"
  1647.  
  1648. tTree StmtFuncDecl;
  1649. tTree NextList;
  1650.  
  1651.   if (t->Kind == kACF_LIST) {
  1652.   if (t->ACF_LIST.Elem->Kind == kACF_BASIC) {
  1653.   if (t->ACF_LIST.Elem->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
  1654. # line 1045 "ChangeDefs.puma"
  1655.   {
  1656. # line 1047 "ChangeDefs.puma"
  1657.    if (! (IsStatementFunction (t->ACF_LIST.Elem->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR))) goto yyL1;
  1658.   {
  1659. # line 1049 "ChangeDefs.puma"
  1660.    set_protocol_stmt (t->ACF_LIST.Elem);
  1661. # line 1051 "ChangeDefs.puma"
  1662.    stmt_protocol ("The following is a statement function");
  1663. # line 1057 "ChangeDefs.puma"
  1664.  StmtFuncDecl = MakeStmtFuncDecl (t->ACF_LIST.Elem->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, t->ACF_LIST.Elem->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP);
  1665.       NextList     = ExtractStatementFunctions (t->ACF_LIST.Next);
  1666.       stmtfuncs    = mDECL_LIST (StmtFuncDecl, stmtfuncs);
  1667.  
  1668.   }
  1669.   }
  1670.    return NextList;
  1671. yyL1:;
  1672.  
  1673.   }
  1674.   }
  1675. # line 1065 "ChangeDefs.puma"
  1676.    return t;
  1677.  
  1678.   }
  1679.   if (t->Kind == kACF_EMPTY) {
  1680. # line 1070 "ChangeDefs.puma"
  1681.    return t;
  1682.  
  1683.   }
  1684.  yyAbort ("ExtractStatementFunctions");
  1685. }
  1686.  
  1687. static bool IsStatementFunction
  1688. # if defined __STDC__ | defined __cplusplus
  1689. (register tTree t)
  1690. # else
  1691. (t)
  1692.  register tTree t;
  1693. # endif
  1694. {
  1695.   if (t == NoTree) return false;
  1696.   if (t->Kind == kINDEXED_VAR) {
  1697.   if (t->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
  1698. # line 1082 "ChangeDefs.puma"
  1699.  {
  1700.   bool Is;
  1701.   tDefinitions Obj;
  1702.   {
  1703. # line 1087 "ChangeDefs.puma"
  1704.  
  1705. # line 1088 "ChangeDefs.puma"
  1706.  
  1707. # line 1090 "ChangeDefs.puma"
  1708.    Obj = GetLocalDecl (t->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident);
  1709. # line 1092 "ChangeDefs.puma"
  1710.  Is = (Obj == NoObject);
  1711.       if (!Is)
  1712.          { Is = (Obj->Kind == kVarObject);
  1713.            if (Is)
  1714.               Is = (Obj->VarObject.Kind->Kind == kVarLocal);
  1715.            if (Is)
  1716.               Is = (VarRank (Obj) == 0);
  1717.          }
  1718.  
  1719. # line 1101 "ChangeDefs.puma"
  1720.    if (! (Is)) goto yyL1;
  1721.   }
  1722.    return true;
  1723.  }
  1724. yyL1:;
  1725.  
  1726.   }
  1727.   }
  1728.   return false;
  1729. }
  1730.  
  1731. static tTree MakeStmtFuncDecl
  1732. # if defined __STDC__ | defined __cplusplus
  1733. (register tTree var, register tTree exp)
  1734. # else
  1735. (var, exp)
  1736.  register tTree var;
  1737.  register tTree exp;
  1738. # endif
  1739. {
  1740. # line 1113 "ChangeDefs.puma"
  1741.  
  1742.    tObject OldObj, NewObj;
  1743.    tTree   ResType, Decl, Formals;
  1744.  
  1745.   if (var->Kind == kINDEXED_VAR) {
  1746.   if (var->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
  1747. # line 1118 "ChangeDefs.puma"
  1748.   {
  1749. # line 1120 "ChangeDefs.puma"
  1750.  Formals = MakeStmtFuncFormals (var->INDEXED_VAR.IND_EXPS);
  1751.  
  1752.     OldObj = GetLocalDecl (var->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident);
  1753.  
  1754.     if (OldObj == NoObject)
  1755.        ResType = mDUMMY_TYPE ();
  1756.      else
  1757.        { if (OldObj->Object.decl->Kind != kVAR_DECL)
  1758.             printf ("Error in MakeStmtFuncDecl\n");
  1759.          ResType = CopyTree(OldObj->Object.decl->VAR_DECL.VAL);
  1760.        }
  1761.  
  1762.  
  1763.  
  1764.     Decl   = mSTMT_FUNC_DECL (var->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident, var->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Pos, Formals, ResType, exp);
  1765.     NewObj = mFuncObject (var->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident, Decl, 0, mENTRY_EMPTY ());
  1766.  
  1767.     if (OldObj != NoObject)
  1768.        ChangeEntry (var->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident, NewObj);
  1769.      else
  1770.        InsertEntry (NewObj);
  1771.  
  1772.   }
  1773.    return Decl;
  1774.  
  1775.   }
  1776.   }
  1777.  yyAbort ("MakeStmtFuncDecl");
  1778. }
  1779.  
  1780. static tTree MakeStmtFuncFormals
  1781. # if defined __STDC__ | defined __cplusplus
  1782. (register tTree Parameters)
  1783. # else
  1784. (Parameters)
  1785.  register tTree Parameters;
  1786. # endif
  1787. {
  1788.   if (Parameters->Kind == kBTE_LIST) {
  1789.   if (Parameters->BTE_LIST.Elem->Kind == kVAR_EXP) {
  1790.   if (Parameters->BTE_LIST.Elem->VAR_EXP.V->Kind == kUSED_VAR) {
  1791. # line 1153 "ChangeDefs.puma"
  1792.  {
  1793.   tTree P;
  1794.   {
  1795. # line 1155 "ChangeDefs.puma"
  1796.  
  1797. # line 1157 "ChangeDefs.puma"
  1798.    P = mVAR_PARAM_DECL (Parameters->BTE_LIST.Elem->VAR_EXP.V->USED_VAR.VARNAME->VAR_OBJ.Ident, Parameters->BTE_LIST.Elem->VAR_EXP.V->USED_VAR.VARNAME->VAR_OBJ.Pos, mDUMMY_TYPE ());
  1799.   }
  1800.   {
  1801.    return mDECL_LIST (P, MakeStmtFuncFormals (Parameters->BTE_LIST.Next));
  1802.   }
  1803.  }
  1804.  
  1805.   }
  1806.   }
  1807. # line 1162 "ChangeDefs.puma"
  1808.   {
  1809. # line 1163 "ChangeDefs.puma"
  1810.    error_protocol ("Illegal Statement Function");
  1811. # line 1164 "ChangeDefs.puma"
  1812.    tree_protocol ("Not a legal parameter : ", Parameters->BTE_LIST.Elem);
  1813.   }
  1814.    return MakeStmtFuncFormals (Parameters->BTE_LIST.Next);
  1815.  
  1816.   }
  1817.   if (Parameters->Kind == kBTE_EMPTY) {
  1818. # line 1168 "ChangeDefs.puma"
  1819.    return mDECL_EMPTY ();
  1820.  
  1821.   }
  1822.  yyAbort ("MakeStmtFuncFormals");
  1823. }
  1824.  
  1825. void BeginChangeDefs ()
  1826. {
  1827. }
  1828.  
  1829. void CloseChangeDefs ()
  1830. {
  1831. }
  1832.